home *** CD-ROM | disk | FTP | other *** search
/ Delphi Magazine Collection 2001 / Delphi Magazine Collection 20001 (2001).iso / DISKS / Issue54 / CCorn / Subscriber_TLB.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  2000-01-10  |  9.1 KB  |  263 lines

  1. unit Subscriber_TLB;
  2.  
  3. // ************************************************************************ //
  4. // WARNING                                                                    
  5. // -------                                                                    
  6. // The types declared in this file were generated from data read from a       
  7. // Type Library. If this type library is explicitly or indirectly (via        
  8. // another type library referring to this type library) re-imported, or the   
  9. // 'Refresh' command of the Type Library Editor activated while editing the   
  10. // Type Library, the contents of this file will be regenerated and all        
  11. // manual modifications will be lost.                                         
  12. // ************************************************************************ //
  13.  
  14. // PASTLWTR : $Revision:   1.88  $
  15. // File generated on 1/10/2000 7:29:20 PM from Type Library described below.
  16.  
  17. // *************************************************************************//
  18. // NOTE:                                                                      
  19. // Items guarded by $IFDEF_LIVE_SERVER_AT_DESIGN_TIME are used by properties  
  20. // which return objects that may need to be explicitly created via a function 
  21. // call prior to any access via the property. These items have been disabled  
  22. // in order to prevent accidental use from within the object inspector. You   
  23. // may enable them by defining LIVE_SERVER_AT_DESIGN_TIME or by selectively   
  24. // removing them from the $IFDEF blocks. However, such items must still be    
  25. // programmatically created via a method of the appropriate CoClass before    
  26. // they can be used.                                                          
  27. // ************************************************************************ //
  28. // Type Lib: C:\My Documents\DelphiMag\Feb00\Events\Subscriber.tlb (1)
  29. // IID\LCID: {99E9A8B0-EF81-40E5-BDC2-08AD7F79D452}\0
  30. // Helpfile: 
  31. // DepndLst: 
  32. //   (1) v2.0 stdole, (C:\WINNT\System32\stdole2.tlb)
  33. //   (2) v4.0 StdVCL, (C:\WINNT\System32\STDVCL40.DLL)
  34. //   (3) v1.0 Publisher, (C:\My Documents\DelphiMag\Feb00\Events\Publisher.dll)
  35. // ************************************************************************ //
  36. {$TYPEDADDRESS OFF} // Unit must be compiled without type-checked pointers. 
  37. interface
  38.  
  39. uses Windows, ActiveX, Classes, Graphics, OleServer, OleCtrls, StdVCL, 
  40.   Publisher_TLB;
  41.  
  42. // *********************************************************************//
  43. // GUIDS declared in the TypeLibrary. Following prefixes are used:        
  44. //   Type Libraries     : LIBID_xxxx                                      
  45. //   CoClasses          : CLASS_xxxx                                      
  46. //   DISPInterfaces     : DIID_xxxx                                       
  47. //   Non-DISP interfaces: IID_xxxx                                        
  48. // *********************************************************************//
  49. const
  50.   // TypeLibrary Major and minor versions
  51.   SubscriberMajorVersion = 1;
  52.   SubscriberMinorVersion = 0;
  53.  
  54.   LIBID_Subscriber: TGUID = '{99E9A8B0-EF81-40E5-BDC2-08AD7F79D452}';
  55.  
  56.   IID_ISubObj: TGUID = '{058E8DFF-0AD5-410A-B891-2C51818D2032}';
  57.   CLASS_SubObj: TGUID = '{F57BF8DC-A3B4-4363-9049-4F058F3AE753}';
  58. type
  59.  
  60. // *********************************************************************//
  61. // Forward declaration of types defined in TypeLibrary                    
  62. // *********************************************************************//
  63.   ISubObj = interface;
  64.   ISubObjDisp = dispinterface;
  65.  
  66. // *********************************************************************//
  67. // Declaration of CoClasses defined in Type Library                       
  68. // (NOTE: Here we map each CoClass to its Default Interface)              
  69. // *********************************************************************//
  70.   SubObj = ISubObj;
  71.  
  72.  
  73. // *********************************************************************//
  74. // Interface: ISubObj
  75. // Flags:     (4416) Dual OleAutomation Dispatchable
  76. // GUID:      {058E8DFF-0AD5-410A-B891-2C51818D2032}
  77. // *********************************************************************//
  78.   ISubObj = interface(IDispatch)
  79.     ['{058E8DFF-0AD5-410A-B891-2C51818D2032}']
  80.   end;
  81.  
  82. // *********************************************************************//
  83. // DispIntf:  ISubObjDisp
  84. // Flags:     (4416) Dual OleAutomation Dispatchable
  85. // GUID:      {058E8DFF-0AD5-410A-B891-2C51818D2032}
  86. // *********************************************************************//
  87.   ISubObjDisp = dispinterface
  88.     ['{058E8DFF-0AD5-410A-B891-2C51818D2032}']
  89.   end;
  90.  
  91. // *********************************************************************//
  92. // The Class CoSubObj provides a Create and CreateRemote method to          
  93. // create instances of the default interface ISubObj exposed by              
  94. // the CoClass SubObj. The functions are intended to be used by             
  95. // clients wishing to automate the CoClass objects exposed by the         
  96. // server of this typelibrary.                                            
  97. // *********************************************************************//
  98.   CoSubObj = class
  99.     class function Create: ISubObj;
  100.     class function CreateRemote(const MachineName: string): ISubObj;
  101.   end;
  102.  
  103.  
  104. // *********************************************************************//
  105. // OLE Server Proxy class declaration
  106. // Server Object    : TSubObj
  107. // Help String      : SubObj Object
  108. // Default Interface: ISubObj
  109. // Def. Intf. DISP? : No
  110. // Event   Interface: 
  111. // TypeFlags        : (2) CanCreate
  112. // *********************************************************************//
  113. {$IFDEF LIVE_SERVER_AT_DESIGN_TIME}
  114.   TSubObjProperties= class;
  115. {$ENDIF}
  116.   TSubObj = class(TOleServer)
  117.   private
  118.     FIntf:        ISubObj;
  119. {$IFDEF LIVE_SERVER_AT_DESIGN_TIME}
  120.     FProps:       TSubObjProperties;
  121.     function      GetServerProperties: TSubObjProperties;
  122. {$ENDIF}
  123.     function      GetDefaultInterface: ISubObj;
  124.   protected
  125.     procedure InitServerData; override;
  126.   public
  127.     constructor Create(AOwner: TComponent); override;
  128.     destructor  Destroy; override;
  129.     procedure Connect; override;
  130.     procedure ConnectTo(svrIntf: ISubObj);
  131.     procedure Disconnect; override;
  132.     property  DefaultInterface: ISubObj read GetDefaultInterface;
  133.   published
  134. {$IFDEF LIVE_SERVER_AT_DESIGN_TIME}
  135.     property Server: TSubObjProperties read GetServerProperties;
  136. {$ENDIF}
  137.   end;
  138.  
  139. {$IFDEF LIVE_SERVER_AT_DESIGN_TIME}
  140. // *********************************************************************//
  141. // OLE Server Properties Proxy Class
  142. // Server Object    : TSubObj
  143. // (This object is used by the IDE's Property Inspector to allow editing
  144. //  of the properties of this server)
  145. // *********************************************************************//
  146.  TSubObjProperties = class(TPersistent)
  147.   private
  148.     FServer:    TSubObj;
  149.     function    GetDefaultInterface: ISubObj;
  150.     constructor Create(AServer: TSubObj);
  151.   protected
  152.   public
  153.     property DefaultInterface: ISubObj read GetDefaultInterface;
  154.   published
  155.   end;
  156. {$ENDIF}
  157.  
  158.  
  159. procedure Register;
  160.  
  161. implementation
  162.  
  163. uses ComObj;
  164.  
  165. class function CoSubObj.Create: ISubObj;
  166. begin
  167.   Result := CreateComObject(CLASS_SubObj) as ISubObj;
  168. end;
  169.  
  170. class function CoSubObj.CreateRemote(const MachineName: string): ISubObj;
  171. begin
  172.   Result := CreateRemoteComObject(MachineName, CLASS_SubObj) as ISubObj;
  173. end;
  174.  
  175. procedure TSubObj.InitServerData;
  176. const
  177.   CServerData: TServerData = (
  178.     ClassID:   '{F57BF8DC-A3B4-4363-9049-4F058F3AE753}';
  179.     IntfIID:   '{058E8DFF-0AD5-410A-B891-2C51818D2032}';
  180.     EventIID:  '';
  181.     LicenseKey: nil;
  182.     Version: 500);
  183. begin
  184.   ServerData := @CServerData;
  185. end;
  186.  
  187. procedure TSubObj.Connect;
  188. var
  189.   punk: IUnknown;
  190. begin
  191.   if FIntf = nil then
  192.   begin
  193.     punk := GetServer;
  194.     Fintf:= punk as ISubObj;
  195.   end;
  196. end;
  197.  
  198. procedure TSubObj.ConnectTo(svrIntf: ISubObj);
  199. begin
  200.   Disconnect;
  201.   FIntf := svrIntf;
  202. end;
  203.  
  204. procedure TSubObj.DisConnect;
  205. begin
  206.   if Fintf <> nil then
  207.   begin
  208.     FIntf := nil;
  209.   end;
  210. end;
  211.  
  212. function TSubObj.GetDefaultInterface: ISubObj;
  213. begin
  214.   if FIntf = nil then
  215.     Connect;
  216.   Assert(FIntf <> nil, 'DefaultInterface is NULL. Component is not connected to Server. You must call ''Connect'' or ''ConnectTo'' before this operation');
  217.   Result := FIntf;
  218. end;
  219.  
  220. constructor TSubObj.Create(AOwner: TComponent);
  221. begin
  222.   inherited Create(AOwner);
  223. {$IFDEF LIVE_SERVER_AT_DESIGN_TIME}
  224.   FProps := TSubObjProperties.Create(Self);
  225. {$ENDIF}
  226. end;
  227.  
  228. destructor TSubObj.Destroy;
  229. begin
  230. {$IFDEF LIVE_SERVER_AT_DESIGN_TIME}
  231.   FProps.Free;
  232. {$ENDIF}
  233.   inherited Destroy;
  234. end;
  235.  
  236. {$IFDEF LIVE_SERVER_AT_DESIGN_TIME}
  237. function TSubObj.GetServerProperties: TSubObjProperties;
  238. begin
  239.   Result := FProps;
  240. end;
  241. {$ENDIF}
  242.  
  243. {$IFDEF LIVE_SERVER_AT_DESIGN_TIME}
  244. constructor TSubObjProperties.Create(AServer: TSubObj);
  245. begin
  246.   inherited Create;
  247.   FServer := AServer;
  248. end;
  249.  
  250. function TSubObjProperties.GetDefaultInterface: ISubObj;
  251. begin
  252.   Result := FServer.DefaultInterface;
  253. end;
  254.  
  255. {$ENDIF}
  256.  
  257. procedure Register;
  258. begin
  259.   RegisterComponents('Servers',[TSubObj]);
  260. end;
  261.  
  262. end.
  263.